home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / EDUCLING / SPELLBEE.LZH / BACH2.BAS < prev    next >
BASIC Source File  |  1984-01-08  |  9KB  |  169 lines
  1. 10 REM *******************************************
  2. 15 REM *  BASIC COMPOSER (BACH TO BASIC)  1.2    *
  3. 20 REM *                 by                      *
  4. 25 REM *            PERRY LEOPOLD                *
  5. 30 REM *                                         *
  6. 35 REM *      copyright 1983 PERRY LEOPOLD       *
  7. 40 REM *          all rights reserved            *
  8. 45 REM *******************************************
  9. 50 CLEAR:KEY OFF:CLS:WIDTH 80:COLOR 15,5,14
  10. 55 QY=1:CL=1
  11. 60 QZ=0
  12. 65 LOCATE 10,15:INPUT "DO YOU WANT TO WORK ON A SONG YOU HAVE SAVED";X$
  13. 70 IF X$="Y" OR X$="y" THEN CLS:COLOR 15,2,14:LOCATE 10,20:INPUT "WHAT IS THE NAME OF THE SONG";C$ ELSE GOTO 85
  14. 75 OPEN "I",1,C$:INPUT #1,B$,EEEE$,EEE$,EE$,E$,AX$,T$:CLOSE:CX=1
  15. 80 GOSUB 570:GOTO 95
  16. 85 CLS:LOCATE 12,20:PRINT "WHAT DO YOU WANT TO CALL YOUR SONG"
  17. 90 LOCATE 16,28:COLOR 14,1,15:INPUT;B$
  18. 95 CLS
  19. 100 IF X$="N" OR X$="n" THEN E$="" ELSE E$=E$+AX$:GOSUB 310
  20. 105 CT=1
  21. 110 LOCATE 25,20:COLOR 15,4:PRINT "ENTER A  ?  FOR A LIST OF MORE OPTIONS"
  22. 115 LOCATE 1,26:COLOR 31,5,15:PRINT B$
  23. 120 FOR L=2 TO 10
  24. 125 LOCATE L,1:COLOR 14,4:PRINT TAB(80)
  25. 130 NEXT L
  26. 135 LOCATE 2,1:COLOR 14,1:GOSUB 585
  27. 140 FOR S=1 TO 5
  28. 145 LOCATE S+12,1:COLOR 15,3:PRINT "|_____________________________________________________________________________|"
  29. 150 NEXT
  30. 155 IF CT>1 THEN X$="Y":GOTO 240
  31. 160 IF X$="y" THEN X$="Y"
  32. 165 IF CX=1 OR AX$="X" THEN LOCATE 1,1:COLOR 15,0:PRINT "PARAMETERS="T$
  33. 166 IF CX=1 OR AX$="X" THEN LOCATE 22,15:COLOR 15,2:INPUT "DO YOU WANT TO CHANGE THE SONG'S PARAMETERS";XP$
  34. 170 IF XP$="Y" OR XP$="y" THEN GOTO 180
  35. 175 IF CX=1 THEN LOCATE 1,1:COLOR 15,0:PRINT "PARAMETERS="T$:CX=2:GOTO 240
  36. 180 LOCATE 22,1:COLOR 15,1:PRINT TAB(80)
  37. 181 LOCATE 22,17:INPUT "SET YOUR TEMPO <32=slowest / 255=fastest>";R$:S$="T":RS$=S$+R$
  38. 185 IF R$="?" THEN AX$="?":GOTO 490
  39. 190 LOCATE 22,1:COLOR 15,1:PRINT TAB(80)
  40. 191 LOCATE 22,7:INPUT "PICK WHAT OCTAVE THE SONG SHOULD START AT <1=lowest / 7=highest>";O$:P$="O":OP$=P$+O$
  41. 195 IF O$="?" THEN AX$="?":GOTO 490
  42. 200 TS=VAL(R$):TP=VAL(O$)
  43. 205 IF CX=2 THEN T$=T$ ELSE T$=RS$+OP$
  44. 210 ON ERROR GOTO 670
  45. 215 IF TS<32 OR TS>255 THEN ERROR 210
  46. 220 IF TP<1 OR TP>7 THEN ERROR 210
  47. 225 LOCATE 1,1:COLOR 15,1:PRINT TAB(18):LOCATE 1,1:COLOR 15,0:PRINT "OCTAVE="OP$:LOCATE 1,71:PRINT "TEMPO="RS$
  48. 230 REM       'ENTER NEW NOTES
  49. 235 REM '
  50. 240 GOSUB 395
  51. 245 LOCATE 12,2:PRINT EEEE$ EEE$ EE$ E$:LOCATE 19,1,1,7,0:COLOR 15,1:INPUT "ENTER NOTES";AX$
  52. 250 CT=CT+1:CL=CL+1
  53. 255 IF AX$="X" OR AX$="x" THEN GOTO 180
  54. 260 IF AX$="R" OR AX$="r" THEN F$="Y":GOSUB 570
  55. 265 IF AX$="@" THEN GOTO 450
  56. 270 IF AX$="?" THEN GOTO 490
  57. 275 IF AX$="*" THEN GOTO 545
  58. 280 IF AX$="0" THEN GOSUB 685:END
  59. 285 ON ERROR GOTO 650
  60. 290 LOCATE 15,3:PRINT AX$:PLAY T$+AX$:GOSUB 640 'CHANGE SUBROUTINE
  61. 295 IF CL=2 THEN CL=1:GOSUB 310
  62. 300 IF CT=2 THEN GOSUB 565
  63. 305 GOTO 140
  64. 310 W=1
  65. 315 IF LEN(EEEE$)+LEN(EEE$)<256 THEN EEEE$=EEEE$+EEE$:EEE$=""
  66. 320 IF LEN(EEE$)+LEN(EE$)<256 THEN EEE$=EEE$+EE$:EE$=""
  67. 325 IF LEN(EE$)+LEN(E$)<256 THEN EE$=EE$+E$:E$=""
  68. 330 AL=255-(LEN(E$))
  69. 335 BL=255-(LEN(EE$))
  70. 340 CL=255-(LEN(EEE$))
  71. 345 DL=255-(LEN(EEEE$))
  72. 350 LET B=(LEN(E$))-BL
  73. 355 LET C=(LEN(EE$))-BL
  74. 360 LET D=(LEN(EEE$))-BL
  75. 365 IF LEN(EEEE$)<255 AND (LEN(EEEE$)+LEN(EEE$))>255 THEN EEEE$=EEEE$+LEFT$(EEE$,DL):EEE$=RIGHT$(EEE$,D)
  76. 370 IF LEN(EEE$)<255 AND (LEN(EEE$)+LEN(EE$))>255 THEN EEE$=EEE$+LEFT$(EE$,CL):EE$=RIGHT$(EE$,C)
  77. 375 IF LEN(EE$)<255 AND (LEN(EE$)+LEN(E$))>255 THEN EE$=EE$+LEFT$(E$,BL):E$=RIGHT$(E$,B)
  78. 380 W=W+1:IF W<4 THEN GOTO 315
  79. 385 RETURN
  80. 390 RETURN
  81. 395 COLOR 15,1:LOCATE 18,1:PRINT TAB(80)
  82. 400 QZ=QZ+.66
  83. 405 QY=QY+2.66
  84. 410 IF QY>8 THEN QY=QY-QZ
  85. 415 IF QY<0 THEN QY=QY+2(QZ)
  86. 420 FOR Q=19 TO 24
  87. 425 QQ=(Q-18)+QY
  88. 430 LOCATE Q,1:COLOR 15,QQ:PRINT TAB(80)
  89. 435 NEXT Q
  90. 440 IF QZ>8 THEN QZ=1
  91. 445 RETURN
  92. 450 IF AX$="@" THEN LOCATE 19,1:PRINT TAB(80):ELSE RETURN
  93. 451 LOCATE 19,16:INPUT "HOW MANY TIMES DO YOU WANT THE SONG TO REPEAT";YZ
  94. 455 IF YZ>300 THEN GOTO 480
  95. 460 XYZ=1
  96. 465 LOCATE 21,1:PRINT TAB(80)
  97. 470 LOCATE 21,35:PRINT XYZ:PLAY T$+EEEE$:PLAY EEE$:PLAY EE$:PLAY E$:XYZ=XYZ+1
  98. 475 IF XYZ<YZ+1 THEN GOTO 470 ELSE GOTO 240
  99. 480 FOR J=18 TO 24
  100. 485 LOCATE J,1:PRINT TAB(80):NEXT J
  101. 486 LOCATE 21,4:PRINT "ARE YOU NUTS??? I'M NOT GOING TO REPEAT THIS THING"YZ"TIMES...TRY AGAIN!":GOTO 450
  102. 490 IF AX$="?" THEN LOCATE 19,1:PRINT TAB(80) ELSE RETURN
  103. 495 FOR J=18 TO 24
  104. 500 LOCATE J,1:PRINT TAB(80):NEXT J
  105. 505 LOCATE 18,13:PRINT "--- ENTER ANY OF THE FOLLOWING OPTIONS AT THE PROMPT ---"
  106. 510 LOCATE 20,11:PRINT "0 = SAVE SONG                X = CHANGE OCTAVE/TEMPO SETTINGS "
  107. 515 LOCATE 21,11:PRINT "R = REPEAT SONG              @ = REPEAT SONG X NUMBER OF TIMES"
  108. 520 LOCATE 22,11:PRINT "* = DISPLAY SONG & CLEAR MEMORY FOR RE-WRITING FROM BEGINNING"
  109. 521 LOCATE 23,1:INPUT "ENTER YOUR CHOICE";AX$
  110. 525 IF AX$="?" THEN LOCATE 19,11:COLOR 15,0:PRINT "       THAT'S ALL SHE WROTE...PLEASE ENTER YOUR CHOICE        "
  111. 526 IF AX$="?" THEN GOTO 510
  112. 530 FOR J=18 TO 24
  113. 535 LOCATE J,1:PRINT TAB(80):NEXT J
  114. 540 IF R$="?" OR O$="?" THEN GOTO 180 ELSE GOTO 250
  115. 545 IF AX$="*" THEN LOCATE 13,1:PRINT EEEE$ EEE$ EE$ E$:EEEE$="":EEE$="":EE$="":E$="":GOTO 240
  116. 550 REM '
  117. 555 REM       'REPEAT SONG REQUEST
  118. 560 REM '
  119. 565 IF AX$="R" THEN RETURN
  120. 570 IF F$="Y" OR X$="Y" THEN COLOR 15,1:LOCATE 20,25:PRINT "OK...HEAR GOES "B$"... "
  121. 571 IF F$="Y" OR X$="Y" THEN LOCATE 12,2:PRINT EEEE$" ":PRINT EEE$" ":PRINT EE$" ":PRINT E$
  122. 572 IF F$="Y" OR X$="Y" THEN PLAY T$+EEEE$:PLAY EEE$:PLAY EE$:PLAY E$:LOCATE 20,1:COLOR 15,4:PRINT TAB(80)
  123. 575 IF AX$="R" OR AX$="r" THEN AX$=""
  124. 580 RETURN
  125. 585 PRINT "--Possible Notes and Values--Rests--Octaves--------Tempo---------Misc. Syntax
  126. 590 PRINT "|  A   A-   A+  |  1 = Whole = P1 | O7  high |  T255 (fastest) |  MS = staccato
  127. 595 PRINT "|  B   B-   --  |  2 =  1/2  = P2 | O6   ^   |    ^            |  ML = legato
  128. 600 PRINT "|  C   --   C+  |  4 =  1/4  = P4 | O5   ^   |    ^            | L # = length
  129. 605 PRINT "|  D   D-   D+  |  8 =  1/8  = P8 | O4 mid C |  T120 (medium)  |  .  = dot note
  130. 610 PRINT "|  E   E-   --  | 16 =  1/16 = P16| O3   ^   |    ^            | N # plays any
  131. 615 PRINT "|  F   --   F+  | 32 =  1/32 = P32| O2   ^   |    ^            |of the 84 notes
  132. 620 PRINT "|  G   G-   G+  | 64 =  1/64 = P64| O1  low  |   T32 (slowest) | N 0 = rest
  133. 625 PRINT " "
  134. 630 PRINT "  Ex: 3 Blind Mice = E D C /fast= T190 EDC or E16 D16 C16 /slow=T40 E1 D1 C1":RETURN
  135. 635 PRINT " "
  136. 640 IF AX$="R" THEN AX$="":GOTO 245
  137. 641 LOCATE 19,1:COLOR 15,1:PRINT TAB(80)
  138. 642 LOCATE 19,15:COLOR 15,2:INPUT "DO YOU WANT TO CHANGE WHAT YOU JUST HEARD (Y/N)";L$
  139. 643 LOCATE 19,1:COLOR 15,4:PRINT TAB(80)
  140. 645 IF L$="Y" OR L$="y" THEN GOTO 245 ELSE E$=E$+AX$:RETURN
  141. 650 IF ERR=5 THEN FOR J=19 TO 24:LOCATE J,1:COLOR 15,4:PRINT TAB(80):NEXT J ELSE GOTO 660
  142. 651 LOCATE 22,2:PRINT "Uh oh...You goofed!  All numbers must come AFTER the notes...and 0 is not O."
  143. 655 LOCATE 23,3:PRINT "By the way...B+, C-, E+, and F- can't be used.  They don't musically exist.":RESUME 245
  144. 660 IF ERR=15 THEN FOR J=19 TO 24:LOCATE J,1:PRINT TAB(80):NEXT J ELSE GOTO 665
  145. 661 LOCATE 22,8:COLOR 15,4:PRINT "Oops...You can only enter so many notes at a time...Try it again...":RESUME 245
  146. 665 IF ERL=280 THEN GOSUB 685:END
  147. 670 IF ERR=210 THEN LOCATE 19,5:PRINT "You goofed...Be careful not to exceed the Octave and Tempo parameters."
  148. 675 IF ERL=215 THEN RESUME 180
  149. 680 IF ERL=220 THEN RESUME 190
  150. 685 LOCATE 22,23:COLOR 15,2:INPUT "DO YOU WANT TO SAVE THIS SONG";XX$
  151. 690 IF XX$="Y" THEN LOCATE 22,20:INPUT "DO YOU WANT TO CHANGE THE SONG'S NAME";XZ$
  152. 695 IF XZ$="Y" OR XZ$="y" THEN LOCATE 22,1:PRINT TAB(80):LOCATE 22,20:INPUT "WHAT WILL IT BE CALLED";B$
  153. 700 IF AX$="0" THEN AX$=" "
  154. 705 IF XX$="Y" THEN OPEN "O",1,B$:PRINT #1,B$;",";EEEE$;",";EEE$;",";EE$;",";E$;",";AX$;",";T$:CLOSE ELSE RETURN
  155. 706 LOCATE 24,20:COLOR 15,4:PRINT "REMEMBER --- YOUR SONG IS CALLED <"B$">"
  156. 710 END
  157. 715 REM ' This program was designed to run on advanced basic (BASICA) and was
  158. 720 REM ' meant to be run on 80 column color moniters.  Modifications for 40
  159. 725 REM ' column moniters are simple enough.  If your version of BASIC does not
  160. 730 REM ' support PLAY statements, those program lines may be modified to SOUND
  161. 735 REM ' statements. A data subroutine can then be included which will serve
  162. 740 REM ' as a table of frequency.  Durations may be entered individually or
  163. 745 REM ' assigned variables.
  164. 750 REM '
  165. 755 REM ' Feedback is welcomed.  Write to us c/o PAN, P.O. Box 454, Skippack,
  166. 760 REM ' PA 19474.  Source: STX453 / Compuserve: 70176,620 / Delphi: PAN
  167. 765 REM '
  168. 770 REM ' MAY THE SCORES BE WITH YOU...
  169.